www.gusucode.com > 落叶冰点万能企业网站内容管理系统 V9.1 > 落叶冰点万能企业网站内容管理系统 V9.1\code\Model\Models\房产信息后台模型\complied\6020640_x_setpage_zi_2222.asp
<% '************************************************************** ' 新动软网站管理系统 ' 官方网站: http://www.aspcpu.com ' 系统作者: 阮丁远(网名:天下程序) ' Copyright 新动软网站管理系统 版权所有 '************************************************************** %> <% dir_set="..\..\..\..\" function get_my_url_and_cang() aryxxa =split(Request.ServerVariables("SCRIPT_NAME"),"/") fileNamexxa = aryxxa(ubound(aryxxa)) strFileNamea=fileNamexxa Fy_Url1=Request.ServerVariables("QUERY_STRING") Fy_a1=split(Fy_Url1,"&") for Fy_x1=0 to ubound(Fy_a1) if Fy_x1=0 then joooin="?" else joooin="&" end if if instr(Fy_a1(Fy_x1),"=")=len(Fy_a1(Fy_x1)) then Fy_v ="" else Fy_v = mid(Fy_a1(Fy_x1),instr(Fy_a1(Fy_x1),"=")+1,len(Fy_a1(Fy_x1))) end if Fy_Cs_name= left(Fy_a1(Fy_x1),instr(Fy_a1(Fy_x1),"=")-1) strFileNamea=strFileNamea&joooin&Fy_Cs_name&"="&Fy_v Next strFileNamea=replace(strFileNamea,"?","$$wenhao$$") get_my_url_and_cang=replace(strFileNamea,"&","$$anlianhao$$") end function Function UrlEncoding_x(DataStr) StrReturn = "" For Si = 1 To Len(DataStr) ThisChr = Mid(DataStr, Si, 1) If Abs(Asc(ThisChr)) < &HFF Then StrReturn = StrReturn & ThisChr Else InnerCode = Asc(ThisChr) If InnerCode < 0 Then InnerCode = InnerCode + &H10000 End If Hight8 = (InnerCode And &HFF00) \ &HFF Low8 = InnerCode And &HFF StrReturn = StrReturn & "%" & Hex(Hight8) & "%" & Hex(Low8) End If Next UrlEncoding_x = StrReturn End Function function replace_huanhang_md(cont) cont=replace(cont,vbcrlf,"$$sx_aspcodex_huanhang$") cont=replace(cont,chr(10),"$$sx_aspcodex_huanhang$") cont= Replace(cont, CHR(13), "$$sx_aspcodex_huanhang$") cont= Replace(cont, CHR(9), "$$sx_aspcodex_huanhang$") cont=replace(cont,"=","$denghaoaspcpu1$") cont=replace(cont,"&","$adnnhaoaspcpu1$") cont=replace(cont,"?","$wnnehaoaspcpu1$") replace_huanhang_md=cont end function function replace_huanhang_md_hy(cont) cont=replace(cont,"$$sx_aspcodex_huanhang$",vbcrlf) cont=replace(cont,"$denghaoaspcpu1$","=") cont=replace(cont,"$adnnhaoaspcpu1$","&") cont=replace(cont,"$wnnehaoaspcpu1$","?") replace_huanhang_md_hy=cont end function function IsValidEmail(email) IsValidEmail = true names = Split(email, "@") if UBound(names) <> 1 then IsValidEmail = false exit function end if for each name in names if Len(name) <= 0 then IsValidEmail = false exit function end if for i = 1 to Len(name) c = Lcase(Mid(name, i, 1)) if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then IsValidEmail = false exit function end if next if Left(name, 1) = "." or Right(name, 1) = "." then IsValidEmail = false exit function end if next if InStr(names(1), ".") <= 0 then IsValidEmail = false exit function end if i = Len(names(1)) - InStrRev(names(1), ".") if i <> 2 and i <> 3 and i <> 4 and i <> 5 and i <> 6 then IsValidEmail = false exit function end if if InStr(email, "..") > 0 then IsValidEmail = false end if end function '以下这个函数及本文件所有函数勿删 function get_logined_username() sussd="" if session("nd_cache_logined_user")<>"" then sussd=session("nd_cache_logined_user") else if request.Cookies("nd_cc_cache_logined_user")<>"" then sussd=request.Cookies("nd_cc_cache_logined_user") end if end if get_logined_username=sussd end function Function n_RemoveHTML_md(strHTML) n_RemoveHTML_md="" on error resume next strHTML=cstr(strHTML&"") Set objRegExp = New Regexp objRegExp.IgnoreCase = True objRegExp.Global = True '取闭合的<> objRegExp.Pattern = "<.+?>" '进行匹配 Set Matches = objRegExp.Execute(strHTML) ' 遍历匹配集合,并替换掉匹配的项目 For Each Match in Matches strHtml=Replace(strHTML,Match.Value,"") Next n_RemoveHTML_md=strHTML Set objRegExp = Nothing End Function '以下这个函数及本文件所有函数勿删 Function get_v_logined_username() if session("nd_cache_logined_user")="" then if request.cookies("nd_cc_cache_logined_user")="" then uuuaa2="" else uuuaa2=request.cookies("nd_cc_cache_logined_user") end if else uuuaa2=session("nd_cache_logined_user") end if get_v_logined_username=uuuaa2 End Function Function get_value_by_id_inbiao(biaonm,id,ziduan) on error resume next err.clear set rs11xgg=server.CreateObject("adodb.recordset") rs11xgg.open "select * from "&biaonm&" where id="&id,newdsoft_conn_obj,1,1 if err.number<>0 then err.clear get_value_by_id_inbiao="名称字段不存在" else if not rs11xgg.eof then get_value_by_id_inbiao=rs11xgg(ziduan) else get_value_by_id_inbiao="此记录不存在" end if end if End Function '以下这个函数及本文件所有函数勿删 function paixu_a(arr,lenarr,cixu_index,lenmaxsb) '次序号字段的索引位置: 'cixu_index redim can(lenarr+1,11) redim can_temp(lenarr+1,11) '排序算法: redim minvalue_index(lenarr+1) lenttt=lenarr for isssaa=0 to lenttt minvalue_index(isssaa)=-123 next '----------paixu code--------------- for nowmin=0 to lenttt firstrun=1 for mppp=0 to lenttt '----------排除排过了的元素 need_break=0 for nowmintest=0 to nowmin if minvalue_index(nowmintest)=mppp then need_break=1 exit for end if next '--------end 排除排过了的元素 if need_break=0 then if firstrun=1 then firstrun=0 minvalue_index(nowmin)=mppp end if end if if need_break=0 then if clng(arr(mppp,cixu_index))<clng(arr(minvalue_index(nowmin),cixu_index)) then minvalue_index(nowmin)=mppp end if end if next next '----------end paixu code------- for nowii=0 to lenttt for iiiaa=0 to lenmaxsb can_temp(nowii,iiiaa)=arr(minvalue_index(nowii),iiiaa) next next for nowii2=0 to lenttt for iiiaa2=0 to lenmaxsb arr(nowii2,iiiaa2)=can_temp(nowii2,iiiaa2) next next paixu_a=arr end function function get_checkbox_value_format(aia) if cstr(aia&"")="1" then get_checkbox_value_format="1" else get_checkbox_value_format="0" end if end function function get_str_value_format(aia) if cstr(aia&"")<>"" then get_str_value_format=""""&aia&"""" else get_str_value_format="""""" end if end function function get_str_value_format_b(aia) if cstr(aia&"")<>"" then get_str_value_format_b=aia else get_str_value_format_b="""""" end if end function function get_is_checked_xm(stra,myid) get_is_checked_xm="0" if stra<>"" then stra_p=split(stra,"|") for sii=0 to ubound(stra_p) stra_p_1=stra_p(sii) stra_p_1_p=split(stra_p_1,",") if cstr(stra_p_1_p(0))=cstr(myid) then get_is_checked_xm=cstr(stra_p_1_p(1)) exit for end if next end if end function function get_self_f_name() '获取自身文件名 aryxx1 =split(Request.ServerVariables("SCRIPT_NAME"),"/") get_self_f_name = aryxx1(ubound(aryxx1)) end function function replace_textare_for_md(LabelContent) if LabelContent="" then replace_textare_for_md="" exit function end if LabelContent=cstr(LabelContent&"") Set regEx = New RegExp regEx.IgnoreCase = True regEx.Global = True '解决文本框重复问题 regEx.Pattern = "(\<textarea\>)" LabelContent = regEx.Replace(LabelContent, "[$textarea]") regEx.Pattern = "(\<\/textarea\>)" LabelContent = regEx.Replace(LabelContent, "[$/textarea]") LabelContent=replace(LabelContent,"<",chr(60)) LabelContent=replace(LabelContent,">",chr(62)) replace_textare_for_md=LabelContent end function function huanyuan_textare_for_md(LabelContent) if LabelContent="" then huanyuan_textare_for_md="" exit function end if LabelContent=cstr(LabelContent&"") Set regEx = New RegExp regEx.IgnoreCase = True regEx.Global = True '解决文本框重复问题 regEx.Pattern = "(\[\$textarea\])" LabelContent = regEx.Replace(LabelContent, "<textarea>") regEx.Pattern = "(\[\$\/textarea\])" LabelContent = regEx.Replace(LabelContent, "</textarea>") huanyuan_textare_for_md=LabelContent end function Class Cls_FSO Public objFSO Private Sub Class_Initialize() Set objFSO = Server.CreateObject("scripting.filesystemobject") End Sub Private Sub class_terminate() Set objFSO = Nothing End Sub '=======文件操作======== '取文件大小 Public Function GetFileSize(FileName) Dim f If ReportFileStatus(FileName) = 1 Then Set f = objFSO.Getfile(FileName) GetFileSize = f.Size Else GetFileSize = -1 End if End Function '文件删除 Public Function deleteAFile(FileSpec) If ReportFileStatus(FileSpec) = 1 Then objFSO.deleteFile(FileSpec) deleteAFile = 1 Else deleteAFile = -1 End if End Function '显示文件列表 Public Function ShowFileList(FolderSpec) Dim f, f1, fc, s If ReportFolderStatus(FolderSpec) = 1 Then Set f = objFSO.GetFolder(FolderSpec) Set fc = f.Files For Each f1 in fc s = s & f1.name s = s & "|" Next ShowFileList = s Else ShowFileList = -1 End if End Function '文件复制 Public Function CopyAFile(SourceFile, DestinationFile) Dim MyFile If ReportFileStatus(SourceFile) = 1 Then Set MyFile = objFSO.GetFile(SourceFile) MyFile.Copy (DestinationFile) CopyAFile = 1 Else CopyAFile = -1 End if End Function '文件移动 Public Function MoveAFile(SourceFile,DestinationFile) If ReportFileStatus(SourceFile) = 1 And ReportFileStatus(DestinationFileORPath) = -1 Then objFSO.MoveFile SourceFile,DestinationFileORPath MoveAFile = 1 Else MoveAFile = -1 End if End Function '文件是否存在? Public Function ReportFileStatus(FileName) Dim msg msg = -1 If (objFSO.FileExists(FileName)) Then msg = 1 Else msg = -1 End If ReportFileStatus = msg End Function '文件创建日期 Public Function ShowDatecreated(FileSpec) Dim f If ReportFileStatus(FileSpec) = 1 Then Set f = objFSO.GetFile(FileSpec) ShowDatecreated = f.Datecreated Else ShowDatecreated = -1 End if End Function '文件属性 Public Function GetAttributes(FileName) Dim f Dim strFileAttributes If ReportFileStatus(FileName) = 1 Then Set f = objFSO.GetFile(FileName) select Case f.attributes Case 0 strFileAttributes = "普通文件。没有设置任何属性。 " Case 1 strFileAttributes = "只读文件。可读写。 " Case 2 strFileAttributes = "隐藏文件。可读写。 " Case 4 strFileAttributes = "系统文件。可读写。 " Case 16 strFileAttributes = "文件夹或目录。只读。 " Case 32 strFileAttributes = "上次备份后已更改的文件。可读写。 " Case 1024 strFileAttributes = "链接或快捷方式。只读。 " Case 2048 strFileAttributes = " 压缩文件。只读。" End select GetAttributes = strFileAttributes Else GetAttributes = -1 End if End Function '最后一次访问/最后一次修改时间 Public Function ShowFileAccessInfo(FileName,InfoType) '//功能:显示文件创建时信息 '//形参:文件名,信息类别 '// 1 -----创建时间 '// 2 -----上次访问时间 '// 3 -----上次修改时间 '// 4 -----文件路径 '// 5 -----文件名称 '// 6 -----文件类型 '// 7 -----文件大小 '// 8 -----父目录 '// 9 -----根目录 Dim f, s If ReportFileStatus(FileName) = 1 then Set f = objFSO.GetFile(FileName) select Case InfoType Case 1 s = f.Datecreated Case 2 s = f.DateLastAccessed Case 3 s = f.DateLastModified Case 4 s = f.Path Case 5 s = f.Name Case 6 s = f.Type Case 7 s = f.Size Case 8 s = f.ParentFolder Case 9 s = f.RootFolder End select ShowFileAccessInfo = s ELse ShowFileAccessInfo = -1 End if End Function '写文本文件 Public Function WriteTxtFile(FileName,TextStr,WriteORAppendType) Const ForReading = 1, ForWriting = 2 , ForAppending = 8 Dim f, m select Case WriteORAppendType Case 1: '文件进行写操作 Set f = objFSO.OpenTextFile(FileName, ForWriting, True) f.Write TextStr f.Close If ReportFileStatus(FileName) = 1 then WriteTxtFile = 1 Else WriteTxtFile = -1 End if Case 2: '文件末尾进行写操作 If ReportFileStatus(FileName) = 1 then Set f = objFSO.OpenTextFile(FileName, ForAppending) f.Write TextStr f.Close WriteTxtFile = 1 Else WriteTxtFile = -1 End if End select End Function '读文本文件 Public Function ReadTxtFile(FileName) Const ForReading = 1, ForWriting = 2 Dim f, m If ReportFileStatus(FileName) = 1 then Set f = objFSO.OpenTextFile(FileName, ForReading) m = f.ReadLine ReadTxtFile = m f.Close Else ReadTxtFile = -1 End if End Function '建立文本文件 '=======目录操作======== '取目录大小 Public Function GetFolderSize(FolderName) Dim f If ReportFolderStatus(FolderName) = 1 Then Set f = objFSO.GetFolder(FolderName) GetFolderSize = f.Size Else GetFolderSize = -1 End if End Function '创建的文件夹 Public Function createFolderDemo(FolderName) Dim f If ReportFolderStatus(Folderspec) = 1 Then createFolderDemo = -1 Else Set f = objFSO.createFolder(FolderName) createFolderDemo = 1 End if End Function '目录删除 Public Function deleteAFolder(Folderspec) If ReportFolderStatus(Folderspec) = 1 Then objFSO.deleteFolder (Folderspec) deleteAFolder = 1 Else deleteAFolder = -1 End if End Function '显示目录列表 Public Function ShowFolderList(FolderSpec) Dim f, f1, fc, s If ReportFolderStatus(FolderSpec) = 1 Then Set f = objFSO.GetFolder(FolderSpec) Set fc = f.SubFolders For Each f1 in fc s = s & f1.name s = s & "|" Next ShowFolderList = s Else ShowFolderList = -1 End if End Function '目录复制 Public Function CopyAFolder(SourceFolder,DestinationFolder) objFSO.CopyFolder SourceFolder,DestinationFolder CopyAFolder = 1 CopyAFolder = -1 End Function '目录进行移动 Public Function MoveAFolder(SourcePath,DestinationPath) If ReportFolderStatus(SourcePath)=1 And ReportFolderStatus(DestinationPath)=0 Then objFSO.MoveFolder SourcePath, DestinationPath MoveAFolder = 1 Else MoveAFolder = -1 End if End Function '判断目录是否存在 Public Function ReportFolderStatus(fldr) Dim msg msg = -1 If (objFSO.FolderExists(fldr)) Then msg = 1 Else msg = -1 End If ReportFolderStatus = msg End Function '目录创建时信息 Public Function ShowFolderAccessInfo(FolderName,InfoType) '//功能:显示目录创建时信息 '//形参:目录名,信息类别 '// 1 -----创建时间 '// 2 -----上次访问时间 '// 3 -----上次修改时间 '// 4 -----目录路径 '// 5 -----目录名称 '// 6 -----目录类型 '// 7 -----目录大小 '// 8 -----父目录 '// 9 -----根目录 Dim f, s If ReportFolderStatus(FolderName) = 1 then Set f = objFSO.GetFolder(FolderName) select Case InfoType Case 1 s = f.Datecreated Case 2 s = f.DateLastAccessed Case 3 s = f.DateLastModified Case 4 s = f.Path Case 5 s = f.Name Case 6 s = f.Type Case 7 s = f.Size Case 8 s = f.ParentFolder Case 9 s = f.RootFolder End select ShowFolderAccessInfo = s ELse ShowFolderAccessInfo = -1 End if End Function '遍历目录 Public Function DisplayLevelDepth(pathspec) Dim f, n ,Path Set f = objFSO.GetFolder(pathspec) If f.IsRootFolder Then DisplayLevelDepth ="指定的文件夹是根文件夹。"&RootFolder Else Do Until f.IsRootFolder Path = Path & f.Name &"<br>" Set f = f.ParentFolder n = n + 1 Loop DisplayLevelDepth ="指定的文件夹是嵌套级为 " & n & " 的文件夹。<br>" & Path End If End Function '========磁盘操作======== '驱动器是否存在? Public Function ReportDriveStatus(drv) Dim msg msg = -1 If objFSO.DriveExists(drv) Then msg = 1 Else msg = -1 End If ReportDriveStatus = msg End Function '可用的返回类型包括 FAT、NTFS 和 CDFS。 Public Function ShowFileSystemType(drvspec) Dim d If ReportDriveStatus(drvspec) = 1 Then Set d = objFSO.GetDrive(drvspec) ShowFileSystemType = d.FileSystem ELse ShowFileSystemType = -1 End if End Function End Class nodooooooa=0 if have_a1="" then have_a1="1" '*********************************************** '函数名:JoinChar '作 用:向地址中加入 ? 或 & '参 数:strUrl ----网址 '返回值:加了 ? 或 & 的网址 '*********************************************** function JoinChar(strUrl) if strUrl="" then JoinChar="" exit function end if if InStr(strUrl,"?")<len(strUrl) then if InStr(strUrl,"?")>1 then if InStr(strUrl,"&")<len(strUrl) then JoinChar=strUrl & "&" else JoinChar=strUrl end if else JoinChar=strUrl & "?" end if else JoinChar=strUrl end if end function 'Dim Fy_Url,Fy_a,Fy_x,Fy_Cs(),Fy_Cl,Fy_Ts,Fy_Zx '---定义部份 头------ Fy_Cl = 2 '处理方式:1=提示信息,2=转向页面,3=先提示再转向 Fy_Zx = "/Error.Asp" '出错时转向的页面 '---定义部份 尾------ 'ruandingyuan xiugai Fy_Url=Request.ServerVariables("QUERY_STRING") Fy_a=split(Fy_Url,"&") redim Fy_Cs(ubound(Fy_a)) for Fy_x=0 to ubound(Fy_a) Fy_Cs(Fy_x) = left(Fy_a(Fy_x),instr(Fy_a(Fy_x),"=")-1) Next For Fy_x=0 to ubound(Fy_Cs) If Fy_Cs(Fy_x)<>"" Then If Instr(LCase(Request(Fy_Cs(Fy_x))),"'")<>0 or Instr(LCase(Request(Fy_Cs(Fy_x))),"and ")<>0 or Instr(LCase(Request(Fy_Cs(Fy_x))),"and%20")<>0 or Instr(LCase(Request(Fy_Cs(Fy_x))),"select")<>0 or (Instr(LCase(Request(Fy_Cs(Fy_x))),"update")<>0 and Instr(LCase(Request(Fy_Cs(Fy_x))),"set")<>0) or Instr(LCase(Request(Fy_Cs(Fy_x))),"chr")<>0 or Instr(LCase(Request(Fy_Cs(Fy_x))),"delete%20from")<>0 or (Instr(LCase(Request(Fy_Cs(Fy_x))),"delete")<>0 and Instr(LCase(Request(Fy_Cs(Fy_x))),"from")<>0) or Instr(LCase(Request(Fy_Cs(Fy_x))),";")<>0 or (Instr(LCase(Request(Fy_Cs(Fy_x))),"insert")<>0 and Instr(LCase(Request(Fy_Cs(Fy_x))),"into")<>0) or Instr(LCase(Request(Fy_Cs(Fy_x))),"mid")<>0 Or Instr(LCase(Request(Fy_Cs(Fy_x))),"master.")<>0 Then Select Case Fy_Cl Case "1" Response.Write "<Script Language=JavaScript>alert('出现错误!参数 "&Fy_Cs(Fy_x)&" 的值中包含非法字符串!\n\n 请不要在参数中出现:;,and%20,select%20,update%20,insert%20,delete,chr 等非法字符!);window.close();</Script>" Case "2" Response.Write "<Script Language=JavaScript>location.href='"&Fy_Zx&"'</Script>" Case "3" Response.Write "<Script Language=JavaScript>alert('出现错误!参数 "&Fy_Cs(Fy_x)&"的值中包含非法字符串!\n\n 请不要在参数中出现:;,and%20,select%20,update%20,insert%20,delete%20,chr 等非法字符!);location.href='"&Fy_Zx&"';</Script>" End Select nodooooooa=1 Response.End End If End If Next 'post方式的sql注入,则直接禁止站点外部提交post if lcase(Request.Servervariables("REQUEST_METHOD"))="post" then server_v1=Cstr(Request.ServerVariables("HTTP_REFERER")) server_v2=Cstr(Request.ServerVariables("SERVER_NAME")) if mid(server_v1,8,len(server_v2))<>server_v2 then nodooooooa=1 response.write "<br><br><center><table border=1 cellpadding=20 bordercolor=black bgcolor=#EEEEEE width=450>" response.write "<tr><td style='font:9pt Verdana'>" response.write "你提交的路径有误,禁止从站点外部提交数据,请不要乱该参数!" response.write "</td></tr></table></center>" response.end end if end if nd_web_output_folder_b="xndasp" nd_web_output_folder_qiye_b="xcomasp" 'Dim ConnStr if nodooooooa=0 then ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(dir_set&"data\##%20newDdata8-5-2##.mdb") Set newdsoft_conn_obj = Server.CreateObject("ADODB.Connection") newdsoft_conn_obj.open ConnStr If Err Then Err.Clear Set newdsoft_conn_obj = Nothing Response.Write "数据库连接出错,请检查Conn.asp文件中的数据库参数设置。" Response.End End If end if if request("ruandingyuan_do")="getinfox" then response.write "本站使用新"&""&"动"&"软系统制作,"&"系"&"统"&"作"&"者:"&"阮"&""&"丁"&"远,官网:ww"&"w.as"&"pcpu.com" response.end end if J_True = "True" J_False = "False" J_Now = "Now()" '获得现在的时间 end if '放在这,以免标签循环嵌套导致本函数循环定义而导致asp错误 '放在这,以免标签循环嵌套导致本函数循环定义而导致asp错误 if is_haved_g_fontaa="" then is_haved_g_fontaa="1" Function getFontMode(str, vColor, vFont,vSize) Dim FontStr, tColor Dim ColorStr, arrColor If IsNull(str) Then getFontMode = "" Exit Function End If getFontMode = str FontStr=str Select Case CInt(vFont) Case 1 FontStr = "<b>" & str & "</b>" Case 2 FontStr = "<em>" & str & "</em>" Case 3 FontStr = "<u>" & str & "</u>" Case 4 FontStr = "<b><em>" & str & "</em></b>" Case 5 FontStr = "<b><u>" & str & "</u></b>" Case 6 FontStr = "<em><u>" & str & "</u></em>" Case 7 FontStr = "<b><em><u>" & str & "</u></em></b>" Case Else FontStr = str End Select getFontMode = FontStr If vColor = "" Then Exit Function 'ColorStr = "," & InitTitleColor 'arrColor = Split(ColorStr, ",") 'If vColor > UBound(arrColor) Then Exit Function 'tColor = Trim(arrColor(vColor)) if vColor ="0" then 'ssscolor="<font style='font-size:"&vSize&" px;'>" 'ssscolor2="</font>" else 'ssscolor="<font color="&vColor&" style='font-size:"&vSize&" px;'>" 'ssscolor2="</font>" ssscolor="<span style='color:"&vColor&";'>" ssscolor2="</span>" end if getFontMode = ssscolor& FontStr & ssscolor2 End Function end if '放在这,以免标签循环嵌套导致本函数循环定义而导致asp错误 if haved_atype_a="" then haved_atype_a="1" function get_art_type(in1) get_art_type="" if in1="1" then get_art_type="<font color=red>[图文]</font>" if in1="2" then get_art_type="<font color=red>[组图]</font>" if in1="3" then get_art_type="<font color=red>[新闻]</font>" if in1="4" then get_art_type="<font color=red>[推荐]</font>" if in1="5" then get_art_type="<font color=red>[注意]</font>" if in1="6" then get_art_type="<font color=red>[转载]</font>" if in1="7" then get_art_type="<font color=red>[最新]</font>" end function end if '放在这,以免标签循环嵌套导致本函数循环定义而导致asp错误 function findx_price(grade_id,str) rst2="" if str<>"" then other_params=split(str,"|") for i=0 to ubound(other_params) sss11=split(other_params(i),":") sss11a=sss11(0) sss11b=sss11(1) if cstr(sss11a)=cstr(grade_id) then rst2=sss11b exit for end if next end if if isnumeric(rst2)<>true then rst2="" end if findx_price=rst2 end function %><% '************************************************************** ' 新 动 软 网 站 管 理系统 ' 系统作者: 阮 丁 远(网名:天 下 程 序) ' Copyright (C) 新 动 软 网站 管 理 系 统 版 权 所有 '************************************************************** %> <% if have_added_funb="" then have_added_funb=1 isnnn=0 function isnnum(num1) If isnumeric(num1) = 0 Or IsNull(num1) or num1 = "" Then isnnn=0 else isnnn=1 end if end function function isddat(n1) If n1 = "" Or IsNull(n1) or IsDate(n1)=false Then isnnn=0 else isnnn=1 end if end function function isyn(n1) isnnn=9999 If n1 = true or n1=1 Then isnnn=1 end if If n1 = false or n1=0 Then isnnn=0 end if end function function get_rs_value(num1) execute("rsaaaaaaa1="&rsxxx1112&"("&num1&")") get_rs_value=rsaaaaaaa1 end function Function nohtml(ByVal str) Set regEx = New RegExp If IsNull(str) Or Trim(str) = "" Then nohtml = "" Exit Function End If regEx.Pattern = "(\<.[^\<]*\>)" str = regEx.Replace(str, "") regEx.Pattern = "(\<\/[^\<]*\>)" str = regEx.Replace(str, "") regEx.Pattern = "\[NextPage(.*?)\]" '解决“当在文章模块的频道中发布的是图片并使用分页标签[NextPage]或内容开始的前几行就使用分页标签时,一旦使用搜索来搜索该文时,搜索页就会显示分页标签”的问题 str = regEx.Replace(str, "") str = Replace(str, "'", "") str = Replace(str, Chr(34), "") str = Replace(str, vbCrLf, "") str = Trim(str) nohtml = str End Function Public Function ReplaceBadChar(strChar) If strChar = "" Or IsNull(strChar) Then ReplaceBadChar = "" Exit Function End If 'Dim strBadChar, arrBadChar, tempChar, i strBadChar = "',%,^,&,?,(,),<,>,[,],{,},/,\,;,:,exists,select,update,insert,=," & Chr(34) & "," & Chr(0) & "" arrBadChar = Split(strBadChar, ",") tempChar = strChar For i = 0 To UBound(arrBadChar) tempChar = Replace(tempChar, arrBadChar(i), "") Next ReplaceBadChar = tempChar End Function Function GetSubStr(ByVal str, ByVal strlen, bShowPoint) If str = "" Then GetSubStr = "" Exit Function End If 'Dim l, t, c, i, strTemp str = Replace(Replace(Replace(Replace(str, " ", " "), """, Chr(34)), ">", ">"), "<", "<") l = Len(str) t = 0 strTemp = str If strlen = "" Then strlen = 0 Else strlen = CLng(strlen) End If For i = 1 To l c = Abs(Asc(Mid(str, i, 1))) If c > 255 Then t = t + 2 Else t = t + 1 End If If t >= strlen Then strTemp = Left(str, i) Exit For End If Next If strTemp <> str And bShowPoint = True Then strTemp = strTemp & "…" End If GetSubStr = Replace(Replace(Replace(Replace(strTemp, " ", " "), Chr(34), """), ">", ">"), "<", "<") End Function ComeUrl = Trim(Request.ServerVariables("HTTP_REFERER")) Action = Trim(Request("Action")) FoundErr = False ErrMsg = "" If Right(InstallDir, 1) <> "/" Then strInstallDir = InstallDir & "/" Else strInstallDir = InstallDir End If Site_Sn = Replace(Replace(LCase(Request.ServerVariables("SERVER_NAME") & InstallDir), "/", ""), ".", "") '************************************************* '函数名:gotTopic '作 用:截字符串,汉字一个算两个字符,英文算一个字符 '参 数:str ----原字符串 ' strlen ----截取长度 '返回值:截取后的字符串 '************************************************* function gotTopic(str,strlen) if isnull(str) or str="" then gotTopic="" exit function end if 'dim l,t,c, i str=replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<") l=len(str) t=0 for i=1 to l c=Abs(Asc(Mid(str,i,1))) if c>255 then t=t+2 else t=t+1 end if if t>=strlen then gotTopic=left(str,i) & "…" exit for else gotTopic=str end if next gotTopic=replace(replace(replace(replace(gotTopic," "," "),chr(34),"""),">",">"),"<","<") end function '************************************************** '函数名:strLength '作 用:求字符串长度。汉字算两个字符,英文算一个字符。 '参 数:str ----要求长度的字符串 '返回值:字符串长度 '************************************************** function strLength(str) 'ON ERROR RESUME NEXT 'dim WINNT_CHINESE WINNT_CHINESE = (len("中国")=2) if WINNT_CHINESE then 'dim l,t,c 'dim i l=len(str) t=l for i=1 to l c=asc(mid(str,i,1)) if c<0 then c=c+65536 if c>255 then t=t+1 end if next strLength=t else strLength=len(str) end if if err.number<>0 then err.clear end function end if %><%set filea=new Cls_FSO pathff="../is_need_complied.asp" if filea.ReportFileStatus(server.mappath(pathff))=1 then response.redirect "../../../../admin/adminModel/D_complie_all_zimodel_before_b.asp?modelid=81&callbackurl=../../Model/Models/房产信息后台模型/complied/6020640_x_setpage_zi_2222.asp" response.end end if %><% '************************************************************** ' 新动软网站管理系统 ' 官方网站: http://www.aspcpu.com ' 系统作者: 阮丁远(网名:天下程序) ' Copyright 新动软网站管理系统 版权所有 '************************************************************** %> <% iscanvipuser="0" if session("nd_admin_login_status_cache")="" then if request.cookies("nd_admin_login_status_cache")="" then uuuaa="" else uuuaa=request.cookies("nd_admin_login_status_cache") end if else uuuaa=session("nd_admin_login_status_cache") end if if uuuaa="" and iscanvipuser<>"1" then response.redirect "../../../../admin/D_admin_login.asp" end if if iscanvipuser="1" then if session("nd_cache_logined_user")="" then if request.cookies("nd_cc_cache_logined_user")="" then uuuaa2="" else uuuaa2=request.cookies("nd_cc_cache_logined_user") end if else uuuaa2=session("nd_cache_logined_user") end if if uuuaa2="" then response.write "<br><br><br><br><br><center>请先登陆你的会员帐号</center><script language=javascript>alert(""请先登陆你的会员帐号"");</script>" response.end end if end if %><html><meta http-equiv="Content-Type" content="text/html; charset=gb2312" /><LINK href='../../../../admin/css.css' type=text/css rel=stylesheet><form action=6020640_x_dosetpage_zi_2222.asp method=post target=_self><br><br><table border=1 cellspacing=0 cellpadding=0 width=650 align=center><tr><td colspan=2 align=middle class=adminth height=23><font color=#ffffff><strong>修改</strong></font></td></tr><tr><td width=180 style='word-break:break-all' height=24><font color=#000000><strong> checkcode:</strong></font></td><td style='word-break:break-all' bgcolor=#ffffff><%'complie-link:label-strat[$$nd_chkcode_inputk$editmode$()] %> <input type=text value='' name=checkboxa size=15> 请输入<img src='../../../../inc/checkcode.asp'><%'complie-link:label-end[$$nd_chkcode_inputk$editmode$()] %></td></tr><tr><td width=180 style='word-break:break-all' height=24><font color=#000000><strong> 默认新闻显示数:</strong></font></td><td style='word-break:break-all' bgcolor=#ffffff><%'complie-link:label-strat[$$nd_renyi_text_inputk$editmode$()] %> <input type=text value="<%=get_last_field_value_setpage("222","ND_U_748ba_2222")%>" name="nd_fm_222" id="nd_fm_222" size=18><%'complie-link:label-end[$$nd_renyi_text_inputk$editmode$()] %></td></tr><tr><td width=180 style='word-break:break-all' height=24><font color=#000000><strong> 默认首页颜色:</strong></font></td><td style='word-break:break-all' bgcolor=#ffffff><%'complie-link:label-strat[$$nd_zjcst_selectk$editmode$("红|$aspcpu_b$|1|$aspcpu_a$|黑|$aspcpu_b$|2|$aspcpu_a$|蓝|$aspcpu_b$|3")] %> <select name="nd_fm_werwerty" id="nd_fm_werwerty"> <option value="no_nd_aspcpu_x_null">请选择</option> <% itmlist="红|$aspcpu_b$|1|$aspcpu_a$|黑|$aspcpu_b$|2|$aspcpu_a$|蓝|$aspcpu_b$|3"&"" if itmlist<>"" then itmlist_p=split(itmlist,"|$aspcpu_a$|") for aai=0 to ubound(itmlist_p) itmlist_p_1=itmlist_p(aai) itmlist_p_1_p=split(itmlist_p_1,"|$aspcpu_b$|") itmlist_p_1_p_1=itmlist_p_1_p(0) itmlist_p_1_p_2=itmlist_p_1_p(1) %> <option value="<%=itmlist_p_1_p_2%>" <%if cstr(get_last_field_value_setpage("werwerty","ND_U_748ba_2222"))=cstr(itmlist_p_1_p_2) then response.write "selected"%>><%=itmlist_p_1_p_1%></option> <% next end if %> </select><%'complie-link:label-end[$$nd_zjcst_selectk$editmode$("红|$aspcpu_b$|1|$aspcpu_a$|黑|$aspcpu_b$|2|$aspcpu_a$|蓝|$aspcpu_b$|3")] %></td></tr><tr><td align=middle colspan=2><input type=submit value='提 交' name=submit1></td></tr></table><input name="id" value="<%=request("id")%>" type=hidden><input name="page_nd_list_pager" value="<%=request("page_nd_list_pager")%>" type=hidden></form><% '************************************************************** ' 新动 软网 站管 理系 统 ' 系统作 者: 阮 丁 远(网 名:柏拉 图的 程序) ' Copyr ight 新 动软网 站 管理系统 版 权所 有 '************************************************************** %> <% function get_last_field_value(fieldname,biao) get_last_field_value="" on error resume next set nd_rs1=server.CreateObject("adodb.recordset") nd_rs1.open "select * from "&biao&" where id="&request("id"),newdsoft_conn_obj,1,1 if not nd_rs1.eof then get_last_field_value=nd_rs1(fieldname) end if nd_rs1.close set nd_rs1=nothing end function '--------------------------- function get_last_field_value_cst(fieldname,biao,urlvarname) get_last_field_value_cst="" on error resume next set nd_rs1=server.CreateObject("adodb.recordset") nd_rs1.open "select * from "&biao&" where id="&request(urlvarname),newdsoft_conn_obj,1,1 if not nd_rs1.eof then get_last_field_value_cst=nd_rs1(fieldname) end if nd_rs1.close set nd_rs1=nothing end function '--------------------------- function get_last_field_value_setpage(fieldname,biao) get_last_field_value_setpage="" on error resume next set nd_rs1=server.CreateObject("adodb.recordset") nd_rs1.open "select * from "&biao&" order by id asc",newdsoft_conn_obj,1,1 if not nd_rs1.eof then get_last_field_value_setpage=nd_rs1(fieldname) end if nd_rs1.close set nd_rs1=nothing end function '--------------------------- '--------------------------- function get_last_field_value_u_setpage(fieldname,biao) get_last_field_value_u_setpage="" on error resume next set nd_rs1=server.CreateObject("adodb.recordset") nd_rs1.open "select * from "&biao&" where nd_u_username='"&get_v_logined_username()&"' order by id asc",newdsoft_conn_obj,1,1 if not nd_rs1.eof then get_last_field_value_u_setpage=nd_rs1(fieldname) end if nd_rs1.close set nd_rs1=nothing end function '--------------------------- function get_list_zd_value(now_id_x,fieldname,biao) get_list_zd_value="" on error resume next set nd_rs1=server.CreateObject("adodb.recordset") nd_rs1.open "select * from "&biao&" where id="&cstr(now_id_x),newdsoft_conn_obj,1,1 if not nd_rs1.eof then get_list_zd_value=nd_rs1(fieldname) end if nd_rs1.close set nd_rs1=nothing end function %></html>